Attribute VB_Name = "modLOD"
Option Explicit
Public Const MAP As Long = 256
Public Const QUAD_MAP As Long = MAP + 1

Private Const EDGE_POINT = 1
Private Const NODE_POINT = 2
Public Const AREA_SIZE As Long = 256
Public Const F = 16#                  ' world scale of one height map cell */
Public Const MAX_VERTS = 30000 ' max # vertices needed to draw LOD terrain */
Private Const AREA_SIZE_HALF = AREA_SIZE / 2

Public Type VEC3
x As Double
y As Double
z As Double
End Type

Public Type NV
vertex As VEC3
normals As VEC3
End Type

Public normals1(0 To AREA_SIZE& - 1, 0 To AREA_SIZE - 1) As VEC3
Public HEIGHT_FIELD(0 To AREA_SIZE - 1, 0 To AREA_SIZE - 1) As Double
Public normals2(0 To AREA_SIZE - 1, 0 To AREA_SIZE - 1) As VEC3

Public triangles_drawn As Long
Public quadtree(0 To QUAD_MAP - 1, 0 To QUAD_MAP - 1) As Long

Private location(2) As Long
Private lod_level As Long ' = 16
Private nvertices(0 To MAX_VERTS - 1) As NV
Private nverts As Long    ' = 0;
Private nfans As Long    ' = 0;
Private ntriangles As Long '= 0;

Private Function QT(x&, y&) As Long
QT = quadtree(x And 255, y And 255)
End Function

Private Function SQR_DISTANCE(v1&(), v2&()) As Long
SQR_DISTANCE = ((v1(0) - v2(0)) * (v1(0) - v2(0))) + ((v1(2) - v2(2)) * (v1(2) - v2(2)))
End Function

Public Sub init_nverts()
lod_level = 10
nverts = 0
nfans = 0
End Sub

Private Sub emit(ByVal x1&, ByVal z1&)
If x1 > 255 Then x1 = 255
If z1 > 255 Then z1 = 255
With nvertices(nverts)
     .vertex.x = F * x1&
     .vertex.y = F * HEIGHT_FIELD(x1&, z1&)
     .vertex.z = F * z1&
     
     .normals.x = normals1(x1&, z1&).x
     .normals.y = normals1(x1&, z1&).y
     .normals.z = normals1(x1&, z1&).z
End With
     nverts = nverts + 1
End Sub

Private Sub endl()

     nvertices(nverts).vertex.x = -9999
     nverts = nverts + 1
     nfans = nfans + 1
     ntriangles = nverts - 2 * nfans
End Sub

Public Function spew_fans() As Long
Dim i As Long
'Dim pv As NV

 '   pv = nvertices

    ' temporarily go to clockwise convention for triangle fans (because my code
    ' cycles the wrong way round)
    '
    glFrontFace ffCW

    glBegin bmTriangleStrip
        For i = 0 To nverts - 1
        With nvertices(i)
            If .vertex.x <= -9990 Then
            
                glEnd
                glBegin bmTriangleFan
            
            Else
            
                glNormal3f .normals.x, .normals.y, .normals.z
                glVertex3f .vertex.x, .vertex.y, .vertex.z
            End If
          End With
        Next i
    
    glEnd
 
    ' revert default (counter clockwise) convention
    glFrontFace ffCCW
    
    spew_fans = ntriangles
End Function

Private Sub set_location(ByVal x&, ByVal z&)

location(0) = x
location(2) = z
End Sub


Private Sub setup_quadtree(ByVal x&, ByVal z&, ByVal width&)
Dim width2 As Long
Dim v1(2) As Long


    
   v1(0) = x
   v1(2) = z
    
   width2 = width / 2
    
   If width > 1 And SQR_DISTANCE(v1, location) < (width * width * lod_level * lod_level) Then
      quadtree(x And 255, z And 255) = NODE_POINT
        
      setup_quadtree x - width2, z - width2, width2
      setup_quadtree x + width2, z - width2, width2
      setup_quadtree x - width2, z + width2, width2
      setup_quadtree x + width2, z + width2, width2
   
   Else
      quadtree(x And 255, z And 255) = EDGE_POINT '// no further subdivision of this square
   End If
End Sub

Private Sub make_fans(ByVal x&, ByVal z&, ByVal width&)
Dim width2&
'Dim zplusw2 As Long
'Dim zminusw2 As Long
'Dim xplusw2 As Long
'Dim xminusw2 As Long

    If (quadtree(x And 255, z And 255) <> NODE_POINT) Then Exit Sub


    width2& = width& / 2

    emit x, z      ' centre of triangle fan


    ' NORTH
    If quadtree((x - width2&) And 255, (z - width2&) And 255) = EDGE_POINT And quadtree((x + width2&) And 255, (z - width2&) And 255) = EDGE_POINT Then
    
    
        If quadtree(x And 255, (z - width& * 2) And 255) = NODE_POINT Or ((z - width&) Mod MAP) = 0 Then
    
            emit x - width&, z - width&
            emit x, z - width&
        
        Else
        ' avoid gap by lowering resolution for this edge
            emit x - width&, z - width&
        End If
    
    ElseIf (quadtree((x - width2&) And 255, (z - width2&) And 255) = EDGE_POINT) Then
    
        emit x - width&, z - width&
        emit x, z - width&
        endl
        emit x, z
    
    ElseIf (quadtree((x + width2&) And 255, (z - width2&) And 255) = EDGE_POINT) Then
    
        emit x, z - width&
    End If

    ' EAST
    If (quadtree((x + width2&) And 255, (z - width2&) And 255) = EDGE_POINT And _
        quadtree((x + width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
    
        If (quadtree((x + width& * 2) And 255, z And 255) = NODE_POINT Or (x + width&) Mod MAP = 0) Then
        
             emit x + width&, z - width&
            emit x + width&, z
        
        Else
        
             emit x + width&, z - width&
        End If
   
    
    ElseIf (quadtree((x + width2&) And 255, (z - width2&) And 255) = EDGE_POINT) Then
    
    
         emit x + width&, z - width&
        emit x + width&, z
        endl
        emit x, z
    
    ElseIf (quadtree((x + width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
        emit x + width&, z
    End If

    ' SOUTH
    If (quadtree((x - width2&) And 255, (z + width2&) And 255) = EDGE_POINT And _
        quadtree((x + width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
    
        If (quadtree(x And 255, (z + width& * 2) And 255) = NODE_POINT Or (z + width&) Mod MAP = 0) Then
        
            emit x + width&, z + width&
            emit x, z + width&
        
        Else
        
            emit x + width&, z + width&
        End If
   
    ElseIf (quadtree((x + width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
        emit x + width, z + width&
        emit x, z + width&
        endl
        emit x, z
    
    ElseIf (quadtree((x - width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
        emit x, z + width&
    End If



    ' WEST
    If (quadtree((x - width2&) And 255, (z + width2&) And 255) = EDGE_POINT And _
        quadtree((x - width2&) And 255, (z - width2&) And 255) = EDGE_POINT) Then
    
    
        If (quadtree((x - width& * 2) And 255, z And 255) = NODE_POINT Or (x - width&) Mod MAP = 0) Then
        
            emit x - width&, z + width&
            emit x - width&, z
        
        Else
        
            emit x - width&, z + width&
        End If
    
    ElseIf (quadtree((x - width2&) And 255, (z + width2&) And 255) = EDGE_POINT) Then
    
        emit x - width&, z + width&
        emit x - width&, z
        endl
        emit x, z
    
    ElseIf (quadtree((x - width2&) And 255, (z - width2&) And 255) = EDGE_POINT) Then
    
        emit x - width&, z
    End If

    emit x - width&, z - width&
    endl


    If (width2& > 1) Then     ' little speedup if width is getting too small
    
        ' recurse into 4 subsquares
        make_fans x - width2&, z - width2&, width2&
        make_fans x + width2&, z - width2&, width2&
        make_fans x - width2&, z + width2&, width2&
        make_fans x + width2&, z + width2&, width2&
    End If
End Sub

Public Sub recalc_terrain(ByVal cam_x&, ByVal cam_z&)



    set_location cam_x&, cam_z&

    ' build quadtree by recursively filling in values into the matrix
    setup_quadtree AREA_SIZE_HALF, AREA_SIZE_HALF, AREA_SIZE_HALF

    '// reset triangle fan list
    init_nverts

    '// construct list of triangle fan using the quadtree
    make_fans AREA_SIZE_HALF, AREA_SIZE_HALF, AREA_SIZE_HALF

End Sub
